home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / dpassf4.f < prev    next >
Text File  |  1989-08-14  |  2KB  |  61 lines
  1.       subroutine dpassf4 (ido,l1,cc,ch,wa1,wa2,wa3)
  2. c
  3. c     Double precision version.  -tk
  4. c
  5. C***BEGIN PROLOGUE  DPASSF4
  6. C***REFER TO DCFFTF
  7. C***ROUTINES CALLED  (NONE)
  8. C***END PROLOGUE  DPASSF4
  9.       implicit double precision (a-h,o-z)
  10.       dimension       cc(ido,4,l1)           ,ch(ido,l1,4)           ,
  11.      1                wa1(1)     ,wa2(1)     ,wa3(1)
  12. C***FIRST EXECUTABLE STATEMENT  DPASSF4
  13.       if (ido .ne. 2) go to 102
  14.       do 101 k=1,l1
  15.          ti1 = cc(2,1,k)-cc(2,3,k)
  16.          ti2 = cc(2,1,k)+cc(2,3,k)
  17.          tr4 = cc(2,2,k)-cc(2,4,k)
  18.          ti3 = cc(2,2,k)+cc(2,4,k)
  19.          tr1 = cc(1,1,k)-cc(1,3,k)
  20.          tr2 = cc(1,1,k)+cc(1,3,k)
  21.          ti4 = cc(1,4,k)-cc(1,2,k)
  22.          tr3 = cc(1,2,k)+cc(1,4,k)
  23.          ch(1,k,1) = tr2+tr3
  24.          ch(1,k,3) = tr2-tr3
  25.          ch(2,k,1) = ti2+ti3
  26.          ch(2,k,3) = ti2-ti3
  27.          ch(1,k,2) = tr1+tr4
  28.          ch(1,k,4) = tr1-tr4
  29.          ch(2,k,2) = ti1+ti4
  30.          ch(2,k,4) = ti1-ti4
  31.   101 continue
  32.       return
  33.   102 do 104 k=1,l1
  34.          do 103 i=2,ido,2
  35.             ti1 = cc(i,1,k)-cc(i,3,k)
  36.             ti2 = cc(i,1,k)+cc(i,3,k)
  37.             ti3 = cc(i,2,k)+cc(i,4,k)
  38.             tr4 = cc(i,2,k)-cc(i,4,k)
  39.             tr1 = cc(i-1,1,k)-cc(i-1,3,k)
  40.             tr2 = cc(i-1,1,k)+cc(i-1,3,k)
  41.             ti4 = cc(i-1,4,k)-cc(i-1,2,k)
  42.             tr3 = cc(i-1,2,k)+cc(i-1,4,k)
  43.             ch(i-1,k,1) = tr2+tr3
  44.             cr3 = tr2-tr3
  45.             ch(i,k,1) = ti2+ti3
  46.             ci3 = ti2-ti3
  47.             cr2 = tr1+tr4
  48.             cr4 = tr1-tr4
  49.             ci2 = ti1+ti4
  50.             ci4 = ti1-ti4
  51.             ch(i-1,k,2) = wa1(i-1)*cr2+wa1(i)*ci2
  52.             ch(i,k,2) = wa1(i-1)*ci2-wa1(i)*cr2
  53.             ch(i-1,k,3) = wa2(i-1)*cr3+wa2(i)*ci3
  54.             ch(i,k,3) = wa2(i-1)*ci3-wa2(i)*cr3
  55.             ch(i-1,k,4) = wa3(i-1)*cr4+wa3(i)*ci4
  56.             ch(i,k,4) = wa3(i-1)*ci4-wa3(i)*cr4
  57.   103    continue
  58.   104 continue
  59.       return
  60.       end
  61.